home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tbmask / maskproc.bas < prev    next >
BASIC Source File  |  1993-12-13  |  6KB  |  155 lines
  1. DefInt A-Z
  2.  
  3. Sub AddZeros (txt As Control, mask As String, dotcount As Integer, wheredot As Integer)
  4.   If dotcount = 1 Then                      ' if a decimal is there
  5.     string1$ = txt.Text                     ' assign text to temp string
  6.     temp$ = Left$(string1$, wheredot - 1)   ' if key is a decimal, shift dollars immediately
  7.     trimtemp$ = RTrim$(temp$)               ' to the left of the decimal
  8.     nspaces = Len(temp$) - Len(trimtemp$)
  9.     If InStr(mask, "$") > 0 Then            ' leave dollar sign alone if there
  10.       Mid$(string1$, 2, Len(temp$) - 1) = Space(nspaces) + Right$(trimtemp$, Len(trimtemp$) - 1)
  11.     Else
  12.       Mid$(string1$, 1, Len(temp$)) = Space(nspaces) + RTrim(temp$)
  13.     End If
  14.     For i = 1 To Len(txt.Text)              ' add zeros after decimal if not there
  15.       If Mid$(string1$, i, 1) > "/" And Mid$(string1$, i, 1) < ":" Then numthere = 1
  16.       If i > wheredot And numthere = 1 And Mid$(string1$, i, 1) = " " Then Mid$(string1$, i, 1) = "0"
  17.     Next i
  18.     numthere = 0                            ' reset
  19.     txt.Text = string1$
  20.   End If
  21. End Sub
  22.  
  23. Sub IsADot (mask As String, dc As Integer, where As Integer)
  24.   ' check to see if the mask contains a decimal
  25.   dc = 0
  26.   where = 0
  27.   For i = 1 To Len(mask)
  28.     If Mid$(mask, i, 1) = "." Then
  29.       dc = dc + 1       ' n of decimals -> dotcount
  30.       where = i         ' location of decimal -> wheredot
  31.     End If
  32.   Next i
  33.  
  34. End Sub
  35.  
  36. Sub KeyData (txt As Control, ky As Integer, mask As String, dotcount As Integer, wheredot As Integer)
  37.   ' ky is keyascii from a keypress event
  38.   If ky <> 8 Then                             ' if ky not Backspace
  39.     posn = txt.SelStart + 1                   ' posn = 0 prior to this statement
  40.     If posn > txt.MaxLength Then ky = 0: Exit Sub
  41.     If posn < txt.MaxLength Then
  42.       If ky = Asc(Mid(mask, posn, 1)) Then    ' keep as a separate If statement
  43.         txt.SelStart = txt.SelStart + 1       ' if cursor is just before immutable
  44.         If Asc(Mid(mask, posn + 1, 1)) <> 32 Then
  45.           txt.SelStart = txt.SelStart + 1     ' if 2nd immutable is there
  46.           posn = posn + 1
  47.         End If
  48.         ky = 0                                ' and immutable is typed, jump over it
  49.         Exit Sub
  50.       End If
  51.     End If
  52.     If (ky < 47 Or ky > 58) And ky <> 46 And ky <> 45 Then
  53.       ky = 0                                ' accept only numbers and decimals and a minus
  54.       Exit Sub
  55.     End If
  56.     If dotcount = 1 And posn > wheredot And ky = 46 Then
  57.       ky = 0                                ' if a decimal is typed after the decimal pt.
  58.       Exit Sub
  59.     End If
  60.     string1$ = txt.Text
  61.     posn = txt.SelStart + 1                   ' get cursor position
  62.     Do While Mid(mask, posn, 1) <> " "
  63.       posn = posn + 1                         ' jump over an immutable char(s)
  64.     Loop
  65.     If dotcount = 1 And posn < wheredot And ky = 46 Then
  66.       temp$ = Left$(string1$, wheredot - 1)   ' if key is a decimal, shift dollars immediately
  67.       trimtemp$ = RTrim$(temp$)               ' to the left of the decimal and get ready to
  68.       nspaces = Len(temp$) - Len(trimtemp$)   ' enter cents
  69.       If InStr(mask, "$") > 0 Then
  70.         Mid$(string1$, 2, Len(temp$) - 1) = Space(nspaces) + Right$(trimtemp$, Len(trimtemp$) - 1)
  71.       Else
  72.         Mid$(string1$, 1, Len(temp$)) = Space(nspaces) + RTrim(temp$)
  73.       End If
  74.       posn = wheredot
  75.     End If
  76.     If (posn > Len(string1$)) Then    'if cursor is at the end then append keystroke to end
  77.       string1$ = txt.Text + Chr$(ky)
  78.     Else                              'else place keystroke in correct position in text
  79.       Mid(string1$, posn, 1) = Chr$(ky)
  80.     End If
  81.     txt.Text = string1$                ' reassign string to text
  82.     txt.SelStart = posn
  83.     ky = 0
  84.   Else                                 ' ky is a backspace
  85.     string1$ = txt.Text
  86.     posn = txt.SelStart                ' get cursor position
  87.     If posn > 0 Then
  88.       If Mid(mask, posn, 1) = " " Then ' not an immutable character
  89.         Mid(string1$, posn, 1) = " "
  90.       Else
  91.         If posn > 1 Then               ' immutable character here
  92.           Do While posn > 1 And Mid(mask, posn, 1) <> " "
  93.             posn = posn - 1            ' backup over one or more immutables
  94.           Loop
  95.           Mid(string1$, posn, 1) = " "  ' erase next char to left
  96.         Else
  97.           posn = posn + 1              ' immutable character in first column
  98.         End If
  99.       End If
  100.     End If
  101.     txt.Text = string1$
  102.     If posn > 0 Then txt.SelStart = posn - 1    ' reposition cursor
  103.     ky = 0                                      ' cancel the keystroke
  104.   End If
  105. End Sub
  106.  
  107. Sub KeyDelete (txt As Control, ky As Integer, mask As String)
  108.   ' ky is keycode from KeyPress
  109.   If ky = 46 Then    ' delete pressed
  110.     posn = txt.SelStart + 1
  111.     If Mid$(mask, posn, 1) = " " Then  ' not just to left of immutable char
  112.       string1$ = Space$(Len(txt.Text))
  113.       i = 1
  114.       j = 1
  115.       Do
  116.         If i = posn Then j = j + 1                    ' position of char being deleted
  117.         If Mid$(mask, i, 1) <> " " Then               ' an immutable
  118.           Mid$(string1$, i, 1) = Mid$(txt.Text, i, 1) ' put immutable into string
  119.           i = i + 1
  120.           j = j + 1
  121.         Else
  122.           If Mid$(mask, j, 1) <> " " Then             ' not an immutable
  123.             x = 0
  124.             Do
  125.               x = x + 1
  126.               Mid$(string1$, i, 1) = Mid$(txt.Text, j + x, 1)
  127.             Loop Until Mid$(mask, j + x, 1) = " " Or j + x >= Len(txt.Text) - 1
  128.           Else
  129.             Mid$(string1$, i, 1) = Mid$(txt.Text, j, 1)   ' put an immutable
  130.           End If
  131.           i = i + 1
  132.           j = j + 1
  133.         End If
  134.       Loop Until i = Len(string1$)
  135.       txt.Text = string1$           ' reassign Text
  136.       txt.SelStart = posn - 1       ' reposition cursor
  137.     Else
  138.       ' cursor is immediately to the left of immutable char, so do nothing
  139.     End If
  140.     ky = 0                          ' cancel the <delete> keystroke
  141.   End If
  142.  
  143. End Sub
  144.  
  145. Sub PutCursor (txt As Control, mask As String)
  146.   PlaceCursor = 1
  147.   Do   ' locate cursor after any immutable chars
  148.     If Mid$(mask, PlaceCursor, 1) = " " Then Exit Do
  149.     If PlaceCursor = Len(mask) Then Exit Do
  150.     PlaceCursor = PlaceCursor + 1
  151.   Loop
  152.   txt.SelStart = PlaceCursor - 1
  153. End Sub
  154.  
  155.